home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog6.arj / CHECKS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  3.3 KB  |  135 lines
  1. { Checks.pas -- Display checkmarked menu items }
  2.  
  3. program Checks;
  4.  
  5. {$R checks.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects;
  8.  
  9. const
  10.  
  11.   id_Menu  = 100;    { Menu resource ID }
  12.   cm_Item1 = 101;    { Command IDs }
  13.   cm_Item2 = 102;
  14.   cm_Item3 = 103;
  15.   cm_Item4 = 104;
  16.   numItems = 4;      { Number of checkmarked commands }
  17.  
  18. type
  19.  
  20.   ChecksApplication = object(TApplication)
  21.     procedure InitMainWindow; virtual;
  22.   end;
  23.  
  24.   PChecksWindow = ^ChecksWindow;
  25.   ChecksWindow = object(TWindow)
  26.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  27.     procedure CMItem1(var Msg: TMessage);
  28.       virtual cm_First + cm_Item1;
  29.     procedure CMItem2(var Msg: TMessage);
  30.       virtual cm_First + cm_Item2;
  31.     procedure CMItem3(var Msg: TMessage);
  32.       virtual cm_First + cm_Item3;
  33.     procedure CMItem4(var Msg: TMessage);
  34.       virtual cm_First + cm_Item4;
  35.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  36.       virtual;
  37.   end;
  38.  
  39.  
  40. {- Toggle a checkmarked menu item on or off }
  41. procedure ToggleCheck(Menu: HMenu; MenuItemID: Word);
  42. var
  43.   MAttr, WCheck: Word;
  44. begin
  45.   MAttr := GetMenuState(Menu, MenuItemID, mf_ByCommand);
  46.   if (MAttr and mf_Checked) = mf_Checked then
  47.     WCheck := mf_ByCommand or mf_Unchecked
  48.   else
  49.     WCheck := mf_ByCommand or mf_Checked;
  50.   CheckMenuItem(Menu, MenuItemID, WCheck)
  51. end;
  52.  
  53.  
  54. { ChecksApplication }
  55.  
  56. {- Initialize ChecksApplication object's window }
  57. procedure ChecksApplication.InitMainWindow;
  58. begin
  59.   MainWindow := New(PChecksWindow, Init(nil, 'Checkmarks in Menus'))
  60. end;
  61.  
  62.  
  63. { ChecksWindow }
  64.  
  65. {- Construct ChecksWindow object }
  66. constructor ChecksWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  67. begin
  68.   TWindow.Init(AParent, ATitle);
  69.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu))
  70. end;
  71.  
  72. { ChecksWindow command response methods }
  73.  
  74. procedure ChecksWindow.CMItem1(var Msg: TMessage);
  75. begin
  76.   ToggleCheck(Attr.Menu, cm_Item1);
  77.   InvalidateRect(HWindow, nil, true)
  78. end;
  79.  
  80. procedure ChecksWindow.CMItem2(var Msg: TMessage);
  81. begin
  82.   ToggleCheck(Attr.Menu, cm_Item2);
  83.   InvalidateRect(HWindow, nil, true)
  84. end;
  85.  
  86. procedure ChecksWindow.CMItem3(var Msg: TMessage);
  87. begin
  88.   ToggleCheck(Attr.Menu, cm_Item3);
  89.   InvalidateRect(HWindow, nil, true)
  90. end;
  91.  
  92. procedure ChecksWindow.CMItem4(var Msg: TMessage);
  93. begin
  94.   ToggleCheck(Attr.Menu, cm_Item4);
  95.   InvalidateRect(HWindow, nil, true)
  96. end;
  97.  
  98. {- Update the display }
  99. procedure ChecksWindow.Paint(PaintDC: HDC;
  100.   var PaintInfo: TPaintStruct);
  101. var
  102.   MAttr, Item: Word;
  103.   StateStr, ItemStr: string[3];
  104.   S: string[40];
  105. begin
  106.   TWindow.Paint(PaintDC, PaintInfo);
  107.   for Item := 0 to numItems - 1 do
  108.   begin
  109.     MAttr := GetMenuState(Attr.Menu, cm_Item1 + Item, mf_Checked);
  110.     if (MAttr and mf_Checked) = mf_Checked then
  111.       StateStr := 'On'
  112.     else
  113.       StateStr := 'Off';
  114.     Str(Item + 1, ItemStr);
  115.     S := 'Item ' + ItemStr + ' state = ' + StateStr;
  116.     TextOut(PaintDC, 80, 40 + (Item * 20), @S[1], Length(S))
  117.   end
  118. end;
  119.  
  120. var
  121.  
  122.   ChecksApp: ChecksApplication;
  123.  
  124. begin
  125.   ChecksApp.Init('ChecksApp');
  126.   ChecksApp.Run;
  127.   ChecksApp.Done
  128. end.
  129.  
  130.  
  131. {--------------------------------------------------------------
  132.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  133.   Revision 1.00    Date: 2/20/1991
  134. ---------------------------------------------------------------}
  135.